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-- BcdTreePack.Mesa Edited by Johnsson on April 12, 1978 5:13 PM 

DIRECTORY 

BcdControlDefs: FROM "bcdcontroldef s", 
BcdDefs: FROM "bcddefs", 
BcdTabDefs: FROM "bcdtabdef s" , 
BcdTreeDefs: FROM "bcdtreedef s", 
SystemDefs: FROM "systemdef s" , 
TableDefs: FROM "tabledefs"; 

DEFINITIONS FROM BcdTreeDefs; 

BcdTreePack: PROGRAM 

IMPORTS TableDefs, SystemDefs 

EXPORTS BcdControlDefs, BcdTreeDefs ■ PUBLIC 

BEGIN 

treeopen: PRIVATE BOOLEAN ♦- FALSE; 

TreeLinkStack: PRIVATE TYPE = DESCRIPTOR FOR ARRAY OF TreeLink; 

Kstack: PRIVATE TreeLinkStack; 
Kindex: PRIVATE CARDINAL; 

tb: PRIVATE TableDefs .TableBase; -- tree base 

updatebase: PRIVATE TableDefs .TableNotif ier ■ 
BEGIN 

tb <- base[BcdDefs.treetype]; RETURN 
END; 

treeinit: PROCEDURE ■ 
BEGIN 

IF treeopen THEN treeerase[]; 
Kstack <- allocStack[100]; Kindex «- 0; 
TableDefs.AddNotifyfupdatebase]; 
treeopen «- TRUE; RETURN 
END; 

treeerase: PROCEDURE ■ 
BEGIN 

treeopen <- FALSE; 
Tab leDefs.DropNotify[ updatebase]; 
freeStack[Kstack]; RETURN 
END; 

allocStack: PRIVATE PROCEDURE [size: CARDINAL] RETURNS [s: TreeLinkStack] « 
BEGIN 

OPEN SystemDefs; 
base: POINTER; 

base <- AllocateSegment[size ,,, SIZE[TreeLink]]; 
s ♦- DESCRIPTOR[base, SegmentSize[base]/SIZE[TreeLink]] ; 
RETURN 
END; 

freeStack: PRIVATE PROCEDURE [s: TreeLinkStack] - 
BEGIN 

OPEN SystemDefs; 

IF LENGTH[s] # THEN FreeSegment[BASE[s]]; 
RETURN 
END; 

expandStack: PRIVATE PROCEDURE [s: TreeLinkStack, delta: CARDINAL] RETURNS [t: TreeLinkStack] 
BEGIN 

i: CARDINAL; 

t <- allocStack[LENGTH[s]+delta]; 

FOR i IN [0 .. MIN[LENGTH[s], LENGTH[t]]) DO t[i] «- s[i] ENDLOOP; 
freeStack[s]; RETURN 
END; 



TreeStackError: PRIVATE ERROR [CARDINAL] - CODE; 
mlpush: PROCEDURE [v: TreeLink] • 
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BEGIN 

IF Kindex >- LENGTH[Kstack] THEN Kstack <- expandStack[Kstack t 25]; 

Kstack[Kindex] «- v; Kindex <- Kindex+1; 

RETURN 

END; 

mlpop: PROCEDURE RETURNS [TreeLink] ■ 
BEGIN 

IF Kindex « THEN ERROR; 
RETURN [Kstack[Kindex«-Kindex-l]] 
END; 

maketree: PROCEDURE [name: NodeName, count: INTEGER] RETURNS [TreeLink] 
BEGIN 

nsons: CARDINAL ■ ABS[count]; 

node: Treelndex ■ TableDef s .GetChunk[TreeNodeSize+nsons]; 
p: TreeXIndex; 
d: INTEGER; 

IF nsons > Kindex THEN ERROR TreeStackError[Kindex] ; 
p <- LOOPHOLE[node + TreeNodeSize + (IF counKO THEN ELSE nsons-1)]; 
d «- IF count<0 THEN 1 ELSE -1; 
THROUGH [1 .. nsons] 

DO 

(tb+p).soni 4- Kstack[Kindex<-Kindex-l]; p <- p + d; 

ENDLOOP; 
(tb+node) .name <- name; (tb+node) .nsons <- nsons; 
RETURN[TreeLink[subtree[ index: node]]] 
END; 

makelist: PROCEDURE [size: INTEGER] RETURNS [TreeLink] » 
BEGIN 

push! ist[size]; 
RETURN [mlpop[]] 
END; 



pushtree: PROCEDURE [name: NodeName, count: INTEGER] » 
BEGIN 

mlpush[maketree[name, count]]; 
RETURN 
END; 

pushlist: PROCEDURE [size: INTEGER] » 
BEGIN 

nsons: CARDINAL = ABS[size]; 
node: Treelndex; 
p: TreeXIndex; 
d: INTEGER; 
SELECT nsons FROM 
1 «> NULL; 
■> mlpush[empty]; 
ENDCASE *> 
BEGIN 

IF nsons > Kindex THEN ERROR TreeStackError[Kindex]; 
IF nsons IN (0. .MaxNSons] 
THEN 
BEGIN 

node *• TableDef s.GetChunk[TreeNodeSize+nsons]; 
p ♦- LOOPHOLE[node + TreeNodeSize+(nsons-l)]; 
END 
ELSE 
BEGIN 

node <- TableDefs.GetChunk[TreeNodeSize+(nsons+l)]; 
p «- LOOPHOLE[node + TreeNodeSize+nsons] ; 
(tb+p).soni <- endmark; p <- p-1; 
END; 
IF size > 
THEN d ♦- -1 
ELSE 

BEGIN d 4- 1; p «- LOOPHOLE[node + TreeNodeSize]; 
END; 
THROUGH [1 .. nsons] 
DO 

(tb+p).soni *- Kstack[Kindex <- Kindex-1]; p ♦■ p+d; 
ENDLOOP; 
(tb+node) .name <- list; 
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(tb+node) .nsons «- IF nsons IN (0. .MaxNSons] THEN nsons ELSE 0; 

ml push[TreeLi nk[ sub tree[ index: node]]]; 

END; 
RETURN 
END; 



pushhash: PROCEDURE [hti: BcdTabDef s.HTIndex] ■ 
BEGIN 

ml push[TreeLink[ hash [index: hti]]]; 
RETURN 
END; 

pushsym: PRIVATE PROCEDURE [sti: BcdTabDef s.STIndex] 
BEGIN 

ml push[TreeLink[ symbol [index: sti]]]; 
RETURN 
END; 



setsourceindex: PROCEDURE [source: CARDINAL] ■ 
BEGIN 

v: TreeLink ■ Kstack[Kindex-l]; 
WITH v SELECT FROM 
subtree «> 

IF index = nullTreelndex THEN ERROR 
ELSE (tb+index) .sourceindex <- source; 
ENDCASE ■> ERROR; 
RETURN 
END; 

setattribute: PROCEDURE [attr: Attribute, value: BOOLEAN] 
BEGIN 

v: TreeLink = Kstack[Kindex-l]; 
WITH v SELECT FROM 
subtree ■> 

IF index = nullTreelndex THEN ERROR 
ELSE SELECT attr FROM 

links => (tb+index) .code! inks <- value; 
ENDCASE »> ERROR; 
ENDCASE «> ERROR; 
RETURN 
END; 



freenode: PROCEDURE [node: Treelndex] ■ 
BEGIN 

p: TreeXIndex; 
n: CARDINAL; 
IF node # nullTreelndex 
THEN 

BEGIN p +■ LOOPHOLE[node + TreeNodeSize] ; 
IF (tb+node) .name # list OR (tb+node) .nsons # 
THEN 

BEGIN n <- (tb+node) .nsons; 
THROUGH [1 .. n] 
DO 

WITH (tb+p).soni SELECT FROM 
subtree a > f reenode[index] ; 
ENDCASE; 
P «- P+l; 
ENDLOOP; 
END 
ELSE 

BEGIN n <~ 1; 

UNTIL (tb+p).soni - endmark 
DO 

WITH (tb+p).soni SELECT FROM 
subtree «> f reenode[index] ; 
ENDCASE; 
n «- n+1; p <- p+l; 
ENDLOOP; 
END; 
TableDef s .FreeChunk[node, TreeNodeSize+n]; 
END; 
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RETURN 
END; 

freetree: PROCEDURE [t: TreeLink] RETURNS [TreeLink] - 
BEGIN 
WITH t SELECT FROM 

subtree ■ > f reenode[index]; 

ENDCASE; 
RETURN [empty] 
END; 

Ktop: PRIVATE PROCEDURE RETURNS [TreeLink] ■ 
BEGIN 

IF Kindex « THEN ERROR TreeStackError[0]; 
RETURN [Kstack[Kindex-l]] 
END; 

KHeight: PRIVATE PROCEDURE RETURNS [CARDINAL] - 
BEGIN 

RETURN [Kindex] 
END; 

-- procedures for tree testing 

testtree: PROCEDURE [t: TreeLink, name: NodeName] RETURNS [BOOLEAN] « 
BEGIN 
RETURN [WITH t SELECT FROM 

subtree ■> index # nullTreelndex AND (tb+index) .name a name, 

ENDCASE «> FALSE] 
END; 

listlength: PROCEDURE [t: TreeLink] RETURNS [CARDINAL] « 
BEGIN 

node: Treelndex; 
p: TreeXIndex; 
n: CARDINAL; 

IF t - empty THEN RETURN [0]; 
WITH t SELECT FROM 
subtree »> 

BEGIN node <- index; 

IF (tb+node). name # list THEN RETURN [1]; 
n <- (tb+node) .nsons; 
IF n # THEN RETURN [n]; 

FOR p <- LOOPHOLE[node+TreeNodeSize], p+1 UNTIL (tb+p).soni ■ endmark 
DO 

n «- n+1; 
ENDLOOP; 
RETURN [n] 
END; 
ENDCASE => RETURN [1] 
END; 

listhead: PROCEDURE [t: TreeLink] RETURNS [TreeLink] - 
BEGIN 

node: Treelndex; 
IF t « empty THEN ERROR; 
WITH t SELECT FROM 
subtree *> 

BEGIN node «- index; 

IF (tb+node). name # list THEN RETURN [t]; 
IF (tb+node). sonl ft endmark THEN RETURN [(tb+node) .sonl]; 
ERROR 
END; 
ENDCASE «> RETURN [t] 
END; 

"listtail: PROCEDURE [t: TreeLink] RETURNS [TreeLink] - 
BEGIN 

node: Treelndex; 
IF t - empty THEN ERROR; 
WITH t SELECT FROM 
subtree -> 

BEGIN node +- index; 

IF (tb+node). name # list THEN RETURN [t]; 
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IF (tb+node) .sonl # endmark 

THEN RETURN [(tb + L00PH0LE[node+TreeNodeSize+(1 istlength[t]-l) , TreeXIndex]) .soni]; 
ERROR; 
END; 
ENDCASE -> RETURN [t] 
END; 

-- procedures for tree traversal 

scanlist: PROCEDURE [root: TreeLink, action: TreeScan] ■ 
BEGIN 

node: Treelndex; 
p: TreeXIndex; 
n: CARDINAL; 
t: TreeLink; 
IF root # empty 
THEN 

WITH root SELECT FROM 
subtree ■> 

BEGIN node «- index; 
IF (tb+node) .name list 
THEN action[root] 
ELSE 

BEGIN p <- L00PH0LE[node + TreeNodeSize]; 
IF (n ♦■ (tb+node) .nsons) # 
THEN 

THROUGH [1 .. n] 
DO 

action[(tb+p) .soni]; p «- p+1; 
ENDLOOP 
ELSE 

UNTIL (t<-(tb+p) .soni) ■ endmark 
DO 

action[t]; p «- p+1; 
ENDLOOP; 
END; 
END; 
ENDCASE -> action[root]; 
RETURN 
END; 

reversescanlist: PROCEDURE [root: TreeLink, action: TreeScan] * 
BEGIN 

node: Treelndex; 
p: TreeXIndex; 
n: CARDINAL; 
IF root # empty 
THEN 

WITH root SELECT FROM 
subtree ■> 

BEGIN node <- index; 
IF (tb+node) .name # list 
THEN action[root] 
ELSE 

BEGIN n <- 1istlength[root]; 
p +- LOOPHOLE[node + TreeNodeSize + n]; 
THROUGH [1 .. n] 
DO 

p «- p - 1; action[(tb+p) .soni]; 
ENDLOOP; 
END; 
END; 
ENDCASE -> action[root]; 
RETURN 
END; 

updatelist: PROCEDURE [root: TreeLink, action: TreeMap] RETURNS [TreeLink] - 
BEGIN 

node: Treelndex; 
p: TreeXIndex; 
n: CARDINAL; 
t: TreeLink; 

IF root - empty THEN RETURN [empty]; 
WITH root SELECT FROM 
subtree «> 

BEGIN node <- index; 
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IF (tb+node).name # list THEN RETURN [action[root]]; 
p «- LOOPHOLE[node + TreeNodeSize]; 
IF (n <- (tb+node) .nsons) # 
THEN 

THROUGH [1 .. n] 
DO 

(tb+p).soni «- action[(tb+p) .soni]; p <- p+1; 
ENDLOOP 
ELSE 
UNTIL (t<-(tb+p).soni) ■ endmark 
DO 

(tb+p).soni <- action[t]; p <- p+1; 
ENDLOOP; 
RETURN [root] 
END; 
ENDCASE -> RETURN [action[root]]; 
END; 

END ... 



